#lang racket


(require mysterx)


(provide 
 add-box
 add-circle
 add-cone
 add-interp-curve
 add-cylinder
 add-loft-surface
 add-sphere
 
 all-objects
 
 boolean-difference
 boolean-intersection
 boolean-union
 
 bounding-box
 
 copy-object
 copy-objects
 
 enable-redraw
 
 delete-object
 delete-objects
 is-object
 move-object
 move-objects
 rotate-object
 rotate-objects
 scale-object
 scale-objects
 
 world-xy-plane
 world-yz-plane
 world-zx-plane)


(define rhino-coclass
  (let ((coclass-name "Rhino4.Interface"))
    (with-handlers ((exn?
                     (λ (e)
                       (displayln "Starting Rhinoceros 3D...")
                       (cci/coclass coclass-name))))
      (gao/coclass coclass-name))))

(com-set-property! rhino-coclass "Visible" true)

(define (connect-rhino)
  (define (try-connection count)
    (with-handlers ((exn?
                     (λ (e)
                       (cond ((> count 0)
                              (displayln "Waiting for Rhinoceros 3D to be ready...")
                              (sleep 1)
                              (try-connection (- count 1)))
                             (else
                              (raise e))))))
      (com-get-property rhino-coclass "GetScriptObject")))
  
  (try-connection 10))

(define rhino-coobject (connect-rhino))


(define (add-box corners)
  (com-invoke rhino-coobject "AddBox" corners))

(define (add-circle plane radius)
  (com-invoke rhino-coobject "AddCircle" plane radius))

(define (add-cone base height radius cap)
  (com-invoke rhino-coobject "AddCone" base height radius cap))

(define (add-interp-curve points)
  (com-invoke rhino-coobject "AddInterpCurve" points 3))

(define (add-cylinder base height radius cap)
  (com-invoke rhino-coobject "AddCylinder" base height radius cap))

(define add-loft-surface
  (case-lambda
    ((objects)
     (com-invoke rhino-coobject "AddLoftSrf" objects))
    ((objects closed)
     (com-invoke rhino-coobject "AddLoftSrf" objects com-omit com-omit com-omit com-omit com-omit closed))
    ((objects start end type style value closed)
     (com-invoke rhino-coobject "AddLoftSrf" objects start end type style value closed))))

(define (add-sphere center radius)
  (com-invoke rhino-coobject "AddSphere" center radius))

(define (all-objects)
  (com-invoke rhino-coobject "AllObjects"))

(define (boolean-difference objects1 objects2 delete)
  (com-invoke rhino-coobject "BooleanDifference" objects1 objects2 delete))

(define (boolean-intersection objects1 objects2 delete)
  (com-invoke rhino-coobject "BooleanIntersection" objects1 objects2 delete))

(define (boolean-union objects delete)
  (com-invoke rhino-coobject "BooleanUnion" objects delete))

(define (bounding-box objects)
  (com-invoke rhino-coobject "BoundingBox" objects))

(define (copy-object object)
  (com-invoke rhino-coobject "CopyObject" object))

(define (copy-objects objects)
  (com-invoke rhino-coobject "CopyObjects" objects))

(define (enable-redraw redraw)
  (com-invoke rhino-coobject "EnableRedraw" redraw))

(define (delete-object object)
  (com-invoke rhino-coobject "DeleteObject" object))

(define (delete-objects object)
  (com-invoke rhino-coobject "DeleteObjects" object))

(define (is-object object)
  (com-invoke rhino-coobject "IsObject" object))

(define (move-object object translation)
  (com-invoke rhino-coobject "MoveObject" object translation))

(define move-objects
  (case-lambda
    ((objects translation)
     (com-invoke rhino-coobject "MoveObjects" objects translation))
    ((objects start end)
     (com-invoke rhino-coobject "MoveObjects" objects start end))))

(define (rotate-object object point angle axis copy)
  (com-invoke rhino-coobject "RotateObject" object point angle axis copy))

(define (rotate-objects objects point angle axis copy)
  (com-invoke rhino-coobject "RotateObjects" objects point angle axis copy))

(define (scale-object object origin scale copy)
  (com-invoke rhino-coobject "ScaleObject" object origin scale copy))

(define (scale-objects objects origin scale copy)
  (com-invoke rhino-coobject "ScaleObjects" objects origin scale copy))

(define (world-xy-plane)
  (com-invoke rhino-coobject "WorldXYPlane"))

(define (world-yz-plane)
  (com-invoke rhino-coobject "WorldYZPlane"))

(define (world-zx-plane)
  (com-invoke rhino-coobject "WorldZXPlane"))
